home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Programmer's Power Pack
/
Delphi Volume 1.iso
/
s_to_z
/
videolab
/
testu.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-15
|
9KB
|
345 lines
unit Testu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VideoLab, ExtCtrls, StdCtrls, Buttons, Menus, MPlayer, Audio;
type
TMainForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
DriverName: TLabel;
VideoCaptureParms: TVideoCaptureParms;
labelStatus: TLabel;
VideoAudioParms: TVideoAudioParms;
VideoLab: TVideoLab;
MainMenu: TMainMenu;
MenuFile: TMenuItem;
MenuExit: TMenuItem;
MenuSaveDIB: TMenuItem;
MenuSaveBitmap: TMenuItem;
MenuEdit: TMenuItem;
MenuEditCopy: TMenuItem;
Setup1: TMenuItem;
MenuFormat: TMenuItem;
MenuSource: TMenuItem;
MenuDisplay: TMenuItem;
MenuCompress: TMenuItem;
MenuVideo: TMenuItem;
MenuPreview: TMenuItem;
MenuOverlay: TMenuItem;
MenuPause: TMenuItem;
MenuPlayback: TMenuItem;
MenuPlay: TMenuItem;
MenuPlayOpen: TMenuItem;
MenuActive: TMenuItem;
MenuCapture: TMenuItem;
MenuOpenExternal: TMenuItem;
MenuPbClose: TMenuItem;
N3: TMenuItem;
N2: TMenuItem;
N1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
MenuSetAudioFormat: TMenuItem;
MenuPlaySpace: TMenuItem;
N6: TMenuItem;
function VideoLabError(Sender: TObject; nId: Integer;
pMsg: PChar): Longint;
function VideoLabStatus(Sender: TObject; nId: Integer;
pMsg: PChar): Longint;
function VideoLabFrame(Sender: TObject; pVideo: PVideoHdr): Longint;
procedure FormCreate(Sender: TObject);
procedure MenuSaveBitmapClick(Sender: TObject);
procedure MenuSaveDIBClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure MenuEditCopyClick(Sender: TObject);
procedure MenuFormatClick(Sender: TObject);
procedure MenuSourceClick(Sender: TObject);
procedure MenuDisplayClick(Sender: TObject);
procedure MenuCompressClick(Sender: TObject);
procedure MenuOverlayClick(Sender: TObject);
procedure MenuPreviewClick(Sender: TObject);
procedure MenuPauseClick(Sender: TObject);
procedure MenuPlayClick(Sender: TObject);
procedure MenuPlayOpenClick(Sender: TObject);
procedure MenuActiveClick(Sender: TObject);
procedure MenuCaptureClick(Sender: TObject);
procedure MenuOpenExternalClick(Sender: TObject);
procedure MenuPbCloseClick(Sender: TObject);
procedure MenuSetAudioFormatClick(Sender: TObject);
procedure MenuPlaySpaceClick(Sender: TObject);
private
nFrameCount: Integer;
private
procedure SetupMenu;
end;
var
MainForm: TMainForm;
DriverCaps: TVideoDriverCaps;
VideoStatus: TVideoStatus;
implementation
{$R *.DFM}
procedure TMainForm.SetupMenu;
begin
{ Get current status }
VideoLab.GetStatus(@VideoStatus);
{ Set menu items }
MenuActive .Checked := VideoLab.Active;
MenuPreview.Checked := VideoStatus.fLiveWindow;
MenuOverlay.Checked := VideoStatus.fOverlayWindow;
end;
function TMainForm.VideoLabError(Sender: TObject; nId: Integer;
pMsg: PChar): Longint;
begin
{ Display error message }
MessageDlg(pMsg, mtError, [mbOK], 0);
VideoLabError := 1;
end;
function TMainForm.VideoLabStatus(Sender: TObject; nId: Integer; pMsg: PChar): Longint;
begin
{ Show the current status }
labelStatus.Caption := pMsg;
VideoLabStatus := 1;
{ Menu }
SetupMenu();
end;
function TMainForm.VideoLabFrame(Sender: TObject; pVideo: PVideoHdr): Longint;
begin
{ Show that we are really doing something }
nFrameCount := nFrameCount + 1;
labelStatus.Caption := Format('Frame: %d', [nFrameCount]);
VideoLabFrame := 1;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
{ Variables }
nFrameCount := 0;
{ Reset all video windows }
VideoLab.Reset();
{ Turn on video }
MenuActiveClick(Sender);
end;
procedure TMainForm.MenuSaveDIBClick(Sender: TObject);
begin
{ Use video driver to save current frame }
VideoLab.FileSaveDIB('\Test.Bmp');
end;
procedure TMainForm.MenuSaveBitmapClick(Sender: TObject);
begin
{ Get current status }
VideoLab.GetStatus(@VideoStatus);
{ Live? }
if (VideoStatus.fOverlayWindow)
then MessageDlg('Video can not be in Overlay mode.', mtError, [mbOK], 0)
{ Save the current frame window to file }
else VideoLab.SaveToBitmap(8, BI_RLE8, '\Test.Bmp');
end;
procedure TMainForm.MenuExitClick(Sender: TObject);
begin
MainForm.Close;
end;
procedure TMainForm.MenuEditCopyClick(Sender: TObject);
begin
{ Copy frame to the clip board }
VideoLab.EditCopy();
end;
procedure TMainForm.MenuFormatClick(Sender: TObject);
begin
{ Display dialog }
if (DriverCaps.fHasDlgVideoFormat)
then VideoLab.FormatDialog()
else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
end;
procedure TMainForm.MenuSourceClick(Sender: TObject);
begin
{ Display dialog }
if (DriverCaps.fHasDlgVideoSource)
then VideoLab.SourceDialog()
else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
end;
procedure TMainForm.MenuDisplayClick(Sender: TObject);
begin
{ Display dialog }
if (DriverCaps.fHasDlgVideoDisplay)
then VideoLab.DisplayDialog()
else MessageDlg('Not supported by video driver', mtInformation, [mbOK], 0);
end;
procedure TMainForm.MenuCompressClick(Sender: TObject);
begin
{ Display dialog }
VideoLab.CompressionDialog();
end;
procedure TMainForm.MenuOverlayClick(Sender: TObject);
begin
{ Turn on Overlay Mode }
VideoLab.Overlay := True;
end;
procedure TMainForm.MenuPreviewClick(Sender: TObject);
begin
{ Turn on Preview Mode }
VideoLab.Preview := True;
VideoLab.PreviewRate := 1;
{ Clear frame counter }
nFrameCount := 0;
end;
procedure TMainForm.MenuPauseClick(Sender: TObject);
begin
{ Stop on the current frame }
VideoLab.GrabFrame(True);
end;
procedure TMainForm.MenuPlayOpenClick(Sender: TObject);
begin
{ Load play back file }
VideoLab.PlaybackLoad(True, MCIWNDF_SHOWNAME, PAnsiChar(VideoLab.AVIFileName));
end;
procedure TMainForm.MenuOpenExternalClick(Sender: TObject);
begin
{ Load play back file }
VideoLab.PlaybackLoad(False, MCIWNDF_SHOWNAME, PAnsiChar(VideoLab.AVIFileName));
end;
procedure TMainForm.MenuPlayClick(Sender: TObject);
begin
{ Start play back }
VideoLab.PlaybackStart();
end;
procedure TMainForm.MenuPbCloseClick(Sender: TObject);
begin
{ Remove playback window }
VideoLab.PlaybackUnload();
end;
procedure TMainForm.MenuActiveClick(Sender: TObject);
var
pTmp: array[0..80] of Char;
begin
{ Toggel video. }
if (VideoLab.Active)
then VideoLab.Active := False
else VideoLab.Active := True;
{ Display }
if (Not VideoLab.Active) then
DriverName.Caption := ''
else
begin
{ Get driver name }
VideoLab.GetDriverName(0, pTmp, 80);
DriverName.Caption := pTmp;
VideoLab.GetDriverVersion(0, pTmp, 80);
DriverName.Caption := DriverName.Caption + ' ' + pTmp;
end;
{ Get driver caps }
VideoLab.GetDriverCaps(@DriverCaps);
{ Get current status }
VideoLab.GetStatus(@VideoStatus);
end;
procedure TMainForm.MenuCaptureClick(Sender: TObject);
var
lSize: Longint;
pBmp: PBITMAPINFOHEADER;
begin
{ Change the Video Format }
lSize := VideoLab.GetVideoFormatSize();
pBmp := MemAlloc(lSize+20);
VideoLab.GetVideoFormat(pBmp, lSize);
{ Set Window size }
pBmp.biWidth := 280;
pBmp.biHeight := 210;
pBmp.biSizeImage := pBmp.biWidth * pBmp.biHeight * pBmp.biPlanes * (pBmp.biBitCount div 8);
{ Save }
VideoLab.SetVideoFormat(pBmp, lSize);
FreeMem(pBmp);
{ Start capturing the video }
VideoLab.Sequence();
end;
procedure TMainForm.MenuSetAudioFormatClick(Sender: TObject);
var
audio: TFormAudio;
begin
audio := TFormAudio.Create(Self);
{ Sample Rate }
if (VideoAudioParms.BitsPerSample = 8)
then audio.rb8bit .Checked := True
else audio.rb16bit.Checked := True;
{ Channels }
if (VideoAudioParms